perm filename RESPS.SAI[PUB,TES] blob sn#233538 filedate 1976-08-21 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00012 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	BEGOF("RESPS")
C00004 00003	PUBLIC SIMPLE PROCEDURE RESPS! $"#
C00005 00004	PUBLIC RECURSIVE BOOLEAN PROCEDURE ATLEAD(INTEGER LEADSPACES) $"#
C00006 00005	PUBLIC RECURSIVE PROCEDURE CLOSET(INTEGER ITSIX BOOLEAN CLOSEIT, DISDECLAREIT) $"#
C00007 00006	PUBLIC SIMPLE PROCEDURE DRESPONSE(INTEGER COMDWD) $"#
C00014 00007	PUBLIC BOOLEAN SIMPLE PROCEDURE FINDINSET(INTEGER HM) $"#
C00015 00008	PUBLIC INTEGER SIMPLE PROCEDURE FINDSIGNAL(INTEGER SIGASC) $"#
C00016 00009	PUBLIC INTEGER SIMPLE PROCEDURE FINDTRAN(INTEGER UASYMB, VARI) $"#
C00017 00010	PUBLIC RECURSIVE PROCEDURE RESPOND(INTEGER IX) $"#
C00018 00011	PUBLIC BOOLEAN SIMPLE PROCEDURE SIGNA(INTEGER SIGCH1) $"#
C00021 00012	FINISHED
C00022 ENDMK
C⊗;
BEGOF("RESPS")


COMMENT

Each variety of response has its own linked list of RESPTYPE records
with currently declared responses.  Each record has an OLD!RESP link
to outer block versions of the same response.  Calling a response is
tricky, especially in the midst of a text line --- the state must be
preserved and restored carefully.

;

PROCEDURES
PUBLIC SIMPLE PROCEDURE RESPS! ;$"#
BEGIN "RESPS!"
GENSYM ← LEADRESPS ← WAITRESP ← 0 ;
RESP!BODY ← FALSE ;
END "RESPS!" ;
PUBLIC RECURSIVE BOOLEAN PROCEDURE ATLEAD(INTEGER LEADSPACES) ;$"#
BEGIN
IF FINDINSET(LEADSPACES) AND FULSTR(SSTK[BODY(LLTHIS)])THEN RESPOND(LLTHIS)
ELSE RETURN(FALSE) ;
RETURN(TRUE) ;
END "ATLEAD" ;
PUBLIC RECURSIVE PROCEDURE CLOSET(INTEGER ITSIX; BOOLEAN CLOSEIT, DISDECLAREIT) ;$"#
BEGIN "CLOSET"
IF DISDECLAREIT THEN DBREAK ;
IF FINDTRAN(LDB(BIXNUM(ITSIX)), 3) THEN
	IF CLOSEIT AND ITSIX NEQ IXPAGE AND  comment AFTER ;
		(IXTYPE(ITSIX)=AREATYPE OR FULSTR(CTR!VAL(PATT!STRS(ITSIX)))) THEN RESPOND(LLTHIS) ;
IF DISDECLAREIT THEN DISD(ITSIX) ← -1 ;
END "CLOSET" ;
PUBLIC SIMPLE PROCEDURE DRESPONSE(INTEGER COMDWD) ;$"#
BEGIN
INTEGER ARGS, SIHIGH, L1, L2, SIG, CLU, VARI, S, A, RIX, J, TYP, XIX, OLDIX ;
STRING PHR, X, BOD ; BOOLEAN ROTTEN, HASBODY ;
SIMPLE PROCEDURE RESPREPL ;
	BEGIN
	RIX ← PUSHI(RESPWDS, RESPTYPE) ;
	NEXT!RESP(RIX) ← LLPOST ; OLD!RESP(RIX) ← LLTHIS ;
	END "RESPREPL" ;
ROTTEN ← FALSE ; ARGS ← 0 ; SIHIGH ← IHIGH ;
IF COMDWD = 1 THEN
	BEGIN "AT"
	PASS ;
	IF ITS(PAGEMARK) THEN BEGIN VARI←2 ; CLU←0 ; L1←FF ; SIG←FF ROT -7 ; PASS END
	ELSE	BEGIN
		X ← SIMPAR ; L1 ← X ;
		IF NULSTR(X) THEN BEGIN VARI←2 ; CLU←0 ; L1←CR ; SIG←CR ROT -7 ; PASS END
		ELSE IF THISWD[1 FOR 1]="0" THEN BEGIN VARI←1 ; CLU←CVD(X) ; PASS END
		TES 11/15/73: TEST ABOVE USED TO BE "0" LEQ L1 LEQ "9".
			ALSO, TOOK OUT "PHRASE RESPONSE", VARI=0;
		ELSE	BEGIN VARI ← 2 ; L1 ← X ; SIG ← CVASC(X) ; CLU ← LENGTH(X) ;
			DPASS ; A ← 0 ;
			WHILE  NOT (ITSCH(;) OR ITSCH(⊂)) DO
				BEGIN
				IF  NOT THISISID THEN
					BEGIN
					WARN("=","Argument must be identifier.") ;
					ROTTEN←TRUE ;
					END ;
				S←SYMB ; PASS ; IF LENGTH(X←SIMPAR) NEQ 1 THEN WARN("=","Separator 1 character only");
				PUTI(1, S) ; A ← A LSH 7 LOR X ; DPASS ;
				END ;
			ARGS ← IHIGH - SIHIGH ;
			IF ARGS>5 THEN
				BEGIN TES 8/26/74 ;
				IHIGH ← SIHIGH + 5 ;
				WARN(NULL, <"SORRY, I FORGOT TO TELL YOU..." & CRLF &
					"THERE IS A 5 ARGUMENT LIMIT ON SIGNAL RESPONSES, WHICH YOU HAVE VIOLATED" & CRLF &
					"MACROS AND PROCEDURES ARE BETTER ANYWAY.">) ;
				END ;
			END ;
		END ;
	END "AT"
ELSE	BEGIN
	PASS ; IF  NOT THISISID THEN BEGIN WARN("=","BEFORE/AFTER need area/counter name") ; ROTTEN←TRUE END
	ELSE BEGIN VARI←IF COMDWD THEN 3 ELSE 4; CLU←SYMB; TYP←THISTYPE; XIX←IX; PASS END ;
	END ;
BOD ← DEFN(FALSE, FALSE,ARGS,SIHIGH) ; OLDIX ← RIX ← -1 ;
IF ROTTEN OR  NOT ON THEN BEGIN IHIGH ← SIHIGH ; RETURN END ;
X ← BOD ; SCAN(X, TO!NON!SP, HASBODY) ; IF  NOT HASBODY THEN BOD ← NULL ;
CASE VARI-1 MIN 2 OF
BEGIN
COMMENT 0... Phrase TES 11/15/73 removed this case ;
COMMENT 1 ... Inset ;IF FINDINSET(CLU) THEN
			IF DEPTH!RESP(LLTHIS) < DEPTH THEN
				BEGIN
				RESPREPL ;
				IF LLPREV<0 THEN LEADRESPS←RIX ELSE NEXT!RESP(LLPREV) ← RIX ;
				END
			ELSE IF HASBODY THEN OLDIX ← RIX ← LLTHIS  TES 11/29/73 OLDIX;
			ELSE	BEGIN
				OLDIX ← LLTHIS ; TES 11/29/73 ;
				LLSKIP(LEADRESPS, <NEXT!RESP>)
				END
		ELSE	BEGIN
			RIX←PUSHI(RESPWDS,RESPTYPE) ;
			LLINS(LEADRESPS,<NEXT!RESP>,RIX) ;
			END ;
COMMENT 2 ... Signal;BEGIN S ← 0 ; comment Old response of same signal: >0 for outer block, <0 same block;
		IF FINDSIGNAL(SIG) THEN 
			BEGIN
			S ← IF DEPTH!RESP(LLTHIS) < DEPTH THEN LLTHIS ELSE -LLTHIS ;
			IF S<0 THEN OLDIX ← LLTHIS; TES 11/29/73 ;
			LLSKIP(SIGNALD[L1], <NEXT!RESP>) ; LLTHIS ← LLPOST ;
			END ;
		IF HASBODY OR S > 0 THEN
			BEGIN
			RIX←PUSHI(SIGWDS,RESPTYPE); SIGNAL(RIX)←SIG ; NUMARGS(RIX) ← ARGS ;
			LLINS(SIGNALD[L1], <NEXT!RESP>, RIX) ; RESP!SEP(RIX) ← A ;
			IF S = 0 THEN SIG!BRC ← (SIG LSH -29) & SIG!BRC ; OLD!RESP(RIX) ← S MAX 0;
			END ;
		IF NULSTR(BOD) AND S THEN
			BEGIN
			X ← NULL ;
			WHILE FULSTR(SIG!BRC) AND (A ← LOP(SIG!BRC)) NEQ L1 DO X ← X & A ;
			SIG!BRC ← X & SIG!BRC ;
			END ;
		SETBREAK(TEXT!TBL, TEXT!BRC&SIG!BRC, NULL, "IS") ;
		END ;
COMMENT 3,4... AFTER/BEFORE area|counter ;
	IF FINDTRAN(CLU, VARI) THEN
		IF DEPTH!RESP(LLTHIS) < DEPTH THEN
			BEGIN
			RESPREPL ;
			IF LLPREV < 0 THEN WAITRESP←RIX ELSE NEXT!RESP(LLPREV) ← RIX ;
			END
		ELSE IF HASBODY THEN OLDIX ← RIX ← LLTHIS
		ELSE	BEGIN
			OLDIX ← LLTHIS ; TES 11/29/73 ;
			LLSKIP(WAITRESP, <NEXT!RESP>)
			END
	ELSE	BEGIN
		RIX←PUSHI(RESPWDS,RESPTYPE) ;
		LLINS(WAITRESP,<NEXT!RESP>,RIX) ;
		END ;
END ;
IF OLDIX GEQ 0 THEN SSTK[BODY(OLDIX)] ← NULL ; TES 11/29/73 GC ;
IF RIX GEQ 0 THEN
BEGIN
CLUE(RIX) ← CLU ; VARIETY(RIX) ← VARI ;
BODY(RIX) ← PUSHS(1,BOD) ; DEPTH!RESP(RIX) ← DEPTH ;
END ;
END "DRESPONSE"  ;
PUBLIC BOOLEAN SIMPLE PROCEDURE FINDINSET(INTEGER HM) ;$"#
BEGIN "FINDINSET"
INTEGER ARE ;
LLSCAN(LEADRESPS, <NEXT!RESP>, <(ARE ← CLUE(LLTHIS)) GEQ HM>) ;
RETURN(LLTHIS AND ARE = HM) ;
END "FINDINSET" ;
PUBLIC INTEGER SIMPLE PROCEDURE FINDSIGNAL(INTEGER SIGASC) ;$"#
BEGIN "FINDSIGNAL"
INTEGER CHR ;
CHR ← SIGASC LSH -29 ;
LLSCAN(<SIGNALD[CHR]>, <NEXT!RESP>, <SIGASC = SIGNAL(LLTHIS)>) ;
RETURN(LLTHIS) ;
END "FINDSIGNAL" ;
PUBLIC INTEGER SIMPLE PROCEDURE FINDTRAN(INTEGER UASYMB, VARI) ;$"#
BEGIN "FINDTRAN"
LLSCAN(WAITRESP, <NEXT!RESP>,
	<CLUE(LLTHIS) = UASYMB AND (VARI=0 OR VARIETY(LLTHIS)=VARI)>) ;
RETURN(LLTHIS) ;
END "FINDTRAN" ;
PUBLIC RECURSIVE PROCEDURE RESPOND(INTEGER IX) ;$"#
IF ON THEN
BEGIN "RESPOND"
INTEGER ARGS ; STRING COM!ENT ;
ARGS ← IF VARIETY(IX) = 2 THEN NUMARGS(IX) ELSE 0 ;
IF VARIETY(IX) < 3 AND IX NEQ SIGNALD[FF] THEN
	BEGIN "AT"
	SWICH(IF IX=SIGNALD[CR] THEN SSTK[BODY(IX)] ELSE ALTMODE&SSTK[BODY(IX)]&RCBRAK, -1, ARGS) ;
	RETURN ;
	END "AT" ;
GENSYM←GENSYM+1 ; COM!ENT ← "!?@"&CVS(GENSYM) ;
BEGINBLOCK( TRUE, 3 , COM!ENT ) ;
SWICH(SSTK[BODY(IX)]&(CRLF&TB&TB&"END """)&COM!ENT&""";;", -1, ARGS) ;
PASS ; TOEND ;
END "RESPOND" ;
PUBLIC BOOLEAN SIMPLE PROCEDURE SIGNA(INTEGER SIGCH1) ;$"#
BEGIN
INTEGER ARG, RIX, ARGS, SEPS ; STRING SEE ;
INTEGER MSSCHAR; STRING MSSBEG; JFR 8-21-76;
SEE ← SIGCH1 & INPUTSTR ;
LLSCAN(<SIGNALD[SIGCH1]>, <NEXT!RESP>, <CVASC(SEE[1 FOR CLUE(LLTHIS)])=SIGNAL(LLTHIS)>) ;
IF LLTHIS = 0 THEN RETURN(FALSE) ; RIX ← LLTHIS ; ARGS ← NUMARGS(RIX) ;
INPUTSTR ← INPUTSTR[CLUE(RIX) TO ∞] ;
IF ARGS THEN	BEGIN "SCAN ARGS"
		SEPS ← RESP!SEP(RIX) ; IF LAST + ARGS > SIZE THEN GROWNESTS ;
		MSSBEG ← ERRLINE&"/"&SRCPAGE&"["&MACLINE&"]";
		FOR ARG ← 1 THRU ARGS DO
			BEGIN "SEPBREAK"
			SETBREAK(LOCAL!TABLE,
				(MSSCHAR←(SEPS LSH ((ARG-ARGS)*7) LAND '177)) & CRLF,
				NULL, "IS") ;
			SEE ← NULL ;
			DO	BEGIN
				SEE ← SEE & RD(LOCAL!TABLE) ;
				IF BRC = CR THEN
					BEGIN
					IF FULSTR(RD(TO!NON!SP)) OR BRC NEQ RCBRAK
						 OR  INPUTSTR[2 FOR 1] NEQ VT THEN DONE ;
					LOPP(INPUTSTR) ; LOPP(INPUTSTR) ; IF FULSTR(SEE) THEN SEE ← SEE & SP ;
					END
				ELSE BRC ← -1 ;
				END UNTIL BRC < 0 ;
			SNEST[LAST + ARG] ← SEE ;
			IF BRC > 0 THEN
				BEGIN
				WARN("=","Missing Signal Separator "&MSSCHAR&
				    (CRLF&"Search began ")&MSSBEG );
				FOR ARG ← ARG+1 THRU ARGS DO SNEST[LAST+ARG] ← NULL ;
				END ;
			END "SEPBREAK" ;
		IF ON THEN LAST ← LAST + ARGS ; COMMENT "IF" JAN 9 1973 ;
		END "SCAN ARGS" ;
RESPOND(RIX) ; RETURN(TRUE) ;
END "SIGNA" ;
FINISHED

ENDOF("RESPS")